perm filename SC3B.F4[M11,LCS]1 blob sn#439868 filedate 1979-05-08 generic text, type T, neo UTF8
	SUBROUTINE RUN2(NRN)
	INTEGER PL,PL4,COPYL
	COMMON /PCIP/ PCH(27,33) /IPT/IPT(27,32) /JPREC/JPREC
C 2ND NUM IN IPT=NUMP+2. (NUMPY)
C PL SHOULD HAVE ABOUT NUMP+17
	COMMON/P/P(30)/PL/PL(47)/NUMP/NUMP,NUMPX,NUMPY/IRX/IR1,IR2
	1 /COPY/COPY(30)  /COPYL/COPYL(30),IT(30)
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20

	COMMON /Q/ BNW(200),NWZ /INS/RINST(27),BG(60) /TYP/JOUT,LN
	1  /ROFF/ROFF(27),RDEV(27),P1(27)
	1 /VV/LIMIT,V(1) /A/NP(27),XT(27),FRM(80),INVIS(27)
	1 /COFF/RREST(27),RNP(27)
C  JPT MUST BE .LE.27*NUMPY !!     ******KPAC(4) FOR PDP11*****
	DIMENSION JPT(837),NCNT(27,32),KPAC(5)
	1,ISC(7),MULT(7)
C   WITH VX AT 70 AND FRM AT 80 OK FOR ONLY 
C   40 LIT CHARS + 30 PARAMS PER INST.
C   60 BG TIMES AVAILABLE.  FOR INSTS AND INSERTS AND EDITS.
	COMMON J,L /DUR/DUR(27) /KNT/KNT(27),BT,IREST,DF
	1/E/IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG
	1 ,VX(70),IAMP,K,KN,M,ML,SPACE
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,FNAME,MZ,N,IDALL,JC,JG,RB,IJ,IX,BW,NL,RC,W,
	1 ZZ,CHN,YY 
	1 /D/TF,AMPFAC,OP1,DURX,IXIN,FLNM
	1 /INTC/NWZZ,IT3,NW,KODE,NPAR,LP,NPA,IBX,IZ,IA
	1  /REALC/T,T1,BY,T6,T2,RD,TDUR,T4,AC
	EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
	1 (VX1,VX(1)),(PL4,PL(4)),(IPT,JPT)
	1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4))
	1 ,(VX5,VX(5)),(KPAC1,KPAC(1)),(KPAC2,KPAC(2)),
	1 (KPAC3,KPAC(3)),(KPAC4,KPAC(4))
	DATA B1X/'1X'/,FRM1/'(1XA'/,FRM2/'4,  '/,COMMA/4H',',/,
	1 BA4/'1XA4'/,BA1/'A1, '/,
	1 BDOL/'$)'/,B2A/' 2F9.'/, NPRLN/8/,
	1 B2B/'3,  '/,B9/'F9.1'/,B8/'F8.3'/,BPRN/')   '/,BLA/' '/
	1, BCOM/',   '/,RNDOFF/1000.0/,IBLA/' '/,PLAY/'PLAY'/,ISEMI/';'/
C********************CHANGE BA4 TO '1XA4' ************************
C******** ALSO FRM1 TO '(1XA'   ---- ETC.!!!!!!!
C  NPRLN IS NUMBER OF PARAMS TO BE PRINTED PER LINE.
	DATA ISC/'C','D','E','F','G','A','B'/,N0/'0'/,ISS/'S'/
	1,ISTAR/'*'/,KSLA/'/'/,MULT/'8','4','2',0,'2','4','8'/
	EQUIVALENCE (FRM1,FRM(1)),(FRM2,FRM(2)),(FRM3,FRM(3)),
	1 (FRM4,FRM(4)),(IFF,ISC(4))

	IF(NRN.EQ.0)GO TO 500
1108	M=0 
	JC=0  
	CCHD=0
C  NWZZ IS SET AT 3111 IN SORTR.  CCHD IS FOR CHORD FEATURE.
CKL	IF(NWZ)GO TO 1740
	IF(NWZ.LT.0)GO TO 31
	DO 740 K=1,NWZZ
	X=BNW(K)    
	IF(X-.0001.GT.BT)GO TO 2740
	IF(X.LE.BW)GO TO 2740
	IF(BW.LT.0)GO TO 2740
	IT(J)=IT(J)*10
	NW=K  
	RETURN
CCC	GO TO 600   
2740	IF(X.LT.1000.)GO TO 740
	IF(X-J*10000.NE.KNT(J)+1.)GO TO 740
	X=BT+PR     
	NW=K  
	IBX=KNT(J)+1
	IT(J)=-3    
	RETURN
CCC	GO TO 600   
740	CONTINUE 
	IT(J)=0     
31      KL=1
2031      KNT(J)=KNT(J)+1   
      ICT=KNT(J)  
C   INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
      NPA=NP(J)   
      PP1=P1(J)  
      IF(BT.GE.DUR(J))GO TO 5174    
	IF(IQ(J).EQ.0)GO TO 200
	P2=-IQ(J)/1000.
	IQ(J)=0
	KNT(J)=-1
	ICT=-1
C  PRINTS REST AND KNT=-1 WHEN 1ST BG TIME IS >0
	GO TO 4203

C   IREST IS FLAG FOR RESTS
200	IREST=0

	DF=1.
C   DF=DUTY FACTOR 
	DO 2155 L=2,NPA
	ISUB=0
C  WHY DOES ISUB APPEAR AT 14700/5?
	IDF=0 
C    IDF IS DUTY FACTOR FLAG
	IJ=IPT(J,L)
3024 	IF(IJ.LT.0)IJ=JPT(-IJ)
	IF(IJ.LT.0)GO TO 3024 
C  FOLLOWS UP ON POINTERS TO POINTERS!
	PM=1.
	IF(IJ.GT.1)GO TO 2157
	P(L)=0
	GO TO 3207 
2157	LN=IJ+2
	NM=ABS(V(IJ-1))+LN-4
	NL=V(IJ)
	IF(NL.GT.-100)GO TO 272
	IF(NL.GT.-200)GO TO 372
	ISUB=-1
	NL=NL+200
C FOR SUBROUTINE FLAG
372	IF(NL.GT.-100)GO TO 272
	IDF=-1
	NL=NL+100
C  DEC.6,72  FINDS DUTY FACTOR PARAM
272	VIJ2=PARAM(V(IJ+1),KN)
C A PARAM NUM CAN APPEAR ANYWHERE A NORMAL NUM IS EXPECTED.
	KIJ2=VIJ2
	KN=NL/(-11)
	IF(KN.EQ.0)GO TO 1100
	GO TO (61,62,62,62,65,65,67,68),KN

1100	IF(KIJ2.EQ.1)GO TO 1200
	ML=3
1900	KA=1
	VX1=0
	DO 1156 K=LN,NM,ML
	X=PARAM(V(K),X)
C NOW % NUM MAY BE A PARAM. (E.G. P22 1,2 ETC.) X IS DUMMY ARG.
	VX(KA+1)=X+VX(KA)
1156	KA=KA+1
	X=RAN(IR1,IR2)

	DO 1157 K=2,21
C LIMIT OF 20 DIFF. %'S OF RAN. SELECTION ON 2 POSSIBLE LINES.
	IF(X.GT.VX(K))GO TO 1157
	KL=K-1
	IF(KN.EQ.7)GO TO 6157
	GO TO 1400
1157	CONTINUE

1400	LN=IJ+3*KL
1462	RA=PARAM(V(LN),K)
	IF(RA.EQ.-10000.)GO TO 4174
C   FOR "FINE" IN RLIST
	RB=PARAM(V(LN+1),K)
C FUNCTION PARAM CHECKS TO SEE IF WE SHOULD LOOK AT ANOTHER PARAMETER FOR DATA.
	PAR=RAND(RA,RB)
1300	IF(NL.EQ.-1)GO TO 1155
	PAR=IFIX(PAR)
	PM=2.
C  IF 2 THEN PRINTS A4
	IF(PAR.GE.199.)IREST=-1
	GO TO 1155
1200	PAR=PARAM(V(IJ+2),PAR)
CHECKS IF REFERING TO OTHER PARAM.
	GO TO 1300

C   NEXT IS FOR SUBROUTINE AND QUAD CALLS
61	IF(NL.LT.-12)GO TO 6100
601	IF(AMOD(V(IJ),1.0).EQ.0)GO TO 871
C FOUND  'MICRO'
	CALL MICRO
	GO TO 3208 
871	X=P2
	CALL SUBR
CC 7/74 NOW SET DUR(J) =0 IN SUBR	IF(DF)GO TO 5174
C* OUT--COLGATE  DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
	IF(L.EQ.2)GO TO 4203
	IF(X.EQ.P2)GO TO 3208 
	PP2=P2
	PR=P2
	GO TO 3208 
C  ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C  TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C  ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C  BE SET TO 'REAL TIME'.)

6100	X=PARAM(V(LN),Z)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
	Y=ABS(X)
	IF(BT.GE.Y)GO TO 2155
	Z=PARAM(V(LN+1),Z)
C FOR 'CUTOFF N1, N2' N1=CUTOFF TIME, N2=SHORTEST NOTE.
C JUMP IF 'TEMPO' CHANGE
	IF(BT+ABS(P2).LT.Y-Z)GO TO 2155
1102	Z=P2
        P2=Y-BT   
	IF(Z.LT.0.OR.X.LT.0)IREST=-1
	PX2=P2
	PP2=PP2/PR*P2
	PR=P2
	GO TO 2155

C   FOLLOWING IS FOR STRINGS OF VALUES.  
62	KL=NCNT(J,L)+1
	IF(KL.GT.KIJ2)KL=1 
	IF(NL.EQ.-46)GO TO 677
	IF(NL.NE.-36)GO TO 162
C   THIS PART FOR STRINGS OF RAND SELECTION
677	LN=KL+IJ+1
	KL=KL+1
	IF(KL.GT.KIJ2)KL=1 
	NL=NL+45
C   FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1.  FOR NOTES, =9)
162	NCNT(J,L)=KL
	IF(NL.GT.-22)GO TO 1462
C   JUMP RAND SELECTION
      PAR=PARAM(V(IJ+KL+1),K)
	IF(K.NE.0)GO TO 1155
C JUMP IF REFERING  TO ANOTHER PARAM.  (I.E. K NOT = 0)
	IF(KN.NE.3)GO TO 1155
	IF(PAR.EQ.-10000.)GO TO 4174
	PM=2.
	IF(PAR.GT.300.)GO TO 777
	IF(PAR.GE.1.)GO TO 877
	IF(NL.NE.-33)GO TO 777
C  NEXT FOR CHORD FEATURE
	PAR=-PAR 
	CCHD=ABS(V(IJ+KL+2))
	KL=KL+1
	IF(KL.GT.KIJ2)KL=1
	NCNT(J,L)=KL
	JCHD=IJ
	LCHD=L
	GO TO 877
777	PM=3.
877	IF(PAR.EQ.199.)IREST=-1
      GO TO 5155  

65	W=-9900.-V(IJ-3)
C  W=BG TIME OF MOVE.
	X=ABS(V(IJ-1))
	IF(NL.EQ.-56)GO TO 977
	IF(NL.NE.-58)GO TO 771
977	PM=2.
771	Z=(BT-W)/VIJ2
C  Z= % OF WAY THROUGH.
	IF(Z.GT.1.)Z=1.
	Y=PARAM(V(LN),Y)
	IX=3
	IF(X.EQ.7)IX=4
	W=PARAM(V(IJ+IX),W)
	IF(NL.LT.-58)GO TO 3205 
	PAR=(W-Y)*Z+Y
	IF(X.EQ.7.)GO TO 1600
	GO TO 255
C   FOR "MOVX"
C  THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
3205 	PAR=RMOVX(W,Y,Z)
C  SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C  THIS NEEDS WORK!
	IF(X.NE.7.)GO TO 255
	W=PARAM(V(IJ+5),W)
	Y=PARAM(V(IJ+3),Y)
	X=RMOVX(W,Y,Z)
	GO TO 3206 
C  NEXT IS FOR MOVING RAND RANGES.
1600	W=PARAM(V(IJ+3),W)
C*********** BACK TO 65 IS NEW.   FEB. 15,71
	X=(PARAM(V(IJ+5),X)-W)*Z+W
3206 	PAR=RAND(PAR,X)
255	IF(PAR.GT.-19999.0)GO TO 155
	PAR=PARAM(PAR+10000.,Y)
C THIS FOR MOVP  -- THE NUMS. ARE E.G. -19999.12, -19999.129
	GO TO 155

67	LN=IJ+3
	NM=LN+KIJ2-1
	ML=1
	GO TO 1900

C 7/74  **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
C ALSO DF.  THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
C  CHANGES.  HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
C  INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
6157	LN=V(LN-1)
	DO 1068 K=1,KL
1068	IF(K.LT.KL)LN=LN+V(LN)+1
2068	PM=LN+1
	PAR=LN+V(LN)
	IF(PM.EQ.2)PAR=IFIX(PAR)
	GO TO 5155

68	KL=NCNT(J,L)
	IF(NL.NE.-1000)GO TO 680

	IF(CCHD.GE.0)GO TO 2155
	IF(NPA.LT.3)NPA=3
C NPA CAN =2 IN SOME CASES, THEN THE NEW CHORD NOTE WOULDN'T PRINT.
	CCHD=0
	KL=NCNT(J,LCHD)+1
	X=V(JCHD+KL)
CKL	IF(X.GE.0)GO TO 9203
	IF(X.GE.0)GO TO 1170
	NCNT(J,LCHD)=KL
	CCHD=ABS(V(JCHD+KL+1))
CKL	GO TO 9203
	GO TO 1170
680	IF(KL.EQ.0)GO TO 774
	IF(KL.NE.10000)GO TO 773
774	KL=KIJ2
773	PM=KL+1
	PAR=PM+V(KL)-1
	KL=PAR+1
	IF(V(KL).NE.-10000.)GO TO 6174
	KNT(J)=KNT(J)-1
	DUR(J)=BT
C  'END' OR 'FINE' IN 'LIT' LIST.
6174	IF(V(KL).EQ.999.)KL=IJ+2
	NCNT(J,L)=KL
	GO TO 5155

155	IF(PM.EQ.2)PAR=IFIX(PAR)
C GETS RID OF UNWANTED DECIMALS
1155	IF(PAR.EQ.-10000.)GO TO 4174
C  TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
5155	P(L)=PAR
3207 	PL(L)=PM
	IF(ISUB.LT.0)GO TO 601
	IF(L.EQ.2)GO TO 4203
3208 	IF(IDF.GE.0)GO TO 2155
	DF=PAR
C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
	IDF=0
2155	CONTINUE
	GO TO 1170

4203      PR=P2 
	PX2=P2
C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
      IF(T5.EQ.0)GO TO 7203   
	IF(IT3.LE.1)GO TO 6203
	IF(BT.LT.TBG+TDUR)GO TO 6203
	K=X+.5
3155	IT3=IT3+3
	TBG=TBG+TDUR
	TDUR=V(IT3)
	IF(BT.GE.TBG+TDUR)GO TO 3155
	T1=V(IT3+1)
	T2=V(IT3+2)
	CALL SQYY(AC,T1,T2,TDUR)
6203	RA=PR 
	IF(BT.EQ.TBG)XT(J)=T1
	K=IT3
	RC=0  
	KA=1  
	Z=TDUR+TBG-BT	
	X=T1  
	Y=T2  
	YY=AC
	CHN=TBG	
	ZZ=TDUR	
      CALL ACCEL
8203	P2=RA*RD    
7203	P2=P2*T4
	X=ABS(P2*TF)
C  P2 IS KEPT WITHOUT TF*
	K=X+0.5
	Y=ROFF(J)
	Y=Y+K-X
	IF(ABS(Y).LT.1.)GO TO 7155
	X=1
	IF(Y.LT.0)X=-X
	K=K-X
	Y=Y-X 

C  ROUND-OFF GAP WILL NOT EXCEED .001****.01 WITH NEW DAC!X?#@(MUS10)
C*********** FEB 17,71
7155	IF(P2.NE.0)GO TO 41710
	WRITE(JTYPE,4171)RINST(J),P1(J)
	IREST=-1
4171	FORMAT(/' ******** WARNING: P2 = 0 ******* ',A4,F)
41710	IF(P2.LT.0)K=-K
	PP2=K/RNDOFF
	ROFF(J)=Y
C   AVOIDS ROUND-OFF PROBLEMS **** TO 1/100 (1/76)
C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!

	
C   NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)

CKL6155	IF(ICT)GO TO 9203
6155	IF(ICT.GE.0)GO TO 2155

1170  IF(BT.NE.0)GO TO 577
	IF(J.EQ.1)GO TO 303
577	IF(IPT(J,1).EQ.0)GO TO 303    
C NEXT FOR 'RR' = RANDOM RESTS
     	X=ALL(JPT,IPT(J,1))
	Y=RAN(IR1,IR2)
C ABOVE IS SAME AS RAND(0.0, 1.0)
	IF(Y-X.LT.0)IREST=-1
303	IF(IPT(J,NUMPX).EQ.0)GO TO 2303
C 'RD' = RANDOM DEVIATION.  THIS BECOMES P31. IT CAN READ ANOTHER P NUM.
C NUMPX=NUMB. OF PARAMS +1
	IF(ICT.LT.0)GO TO 2303
     	X=ALL(JPT,IPT(J,NUMPX))/2.
	IF(PP2.GE.0)GO TO 615
	IREST=-1
	PP2=-PP2
615	Y=IFIX(RAND(-X,X)*RNDOFF+.5)/RNDOFF
C ROUNDS TO 1/100 OR 1/1000 -- RNDOFF
	W=RDEV(J)
	IF(ABS(W+Y).GT.X)Y=-Y
C  TOTAL RAND DEV.(RDEV) WON'T EXCEED P100
	RDEV(J)=W+Y
	PP2=PP2+Y
C  SET P100 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)

2303      IF(IREST.LT.0)GO TO 2022
	IF(PP2.LT.0)GO TO 2022   

	ZPAR=PP1
	P1(J)=PP1+PP2
C   ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
	RIN=RINST(J)
2021	IF(PP1.LT.OP1)GO TO 2612
	IF(INVIS(J).LT.0)GO TO 2170
C  ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
	IF(INONLY.GT.0)GO TO 1204
4021	IF(P(NPA).NE.COPY(NPA))GO TO 5021
	IF(PL(NPA).NE.COPYL(NPA))GO TO 5021
	IF(PL(NPA).GT.2)GO TO 5021
C  'LIT' DATA WILL ALWAYS PRINT BUT NOT NOTES OR FUNCS.
	NPA=NPA-1
	IF(NPA.GT.2)GO TO 4021
5021	DO 1304 K=3,NPA
	COPYL(K)=PL(K)
1304	COPY(K)=P(K)
1204	IF(PL4.NE.1)GO TO 2170
	P4=P4*AMPFAC
	W=0
	RNP(J)=P4
	DO 1021	K=1,NINS
1021	IF(P1(K).GT.PP1)W=W+RNP(K)
	IF(W-RAMP.LE.0)GO TO 2170
	RAMP=W
	AMPTIM=PP1
2170	IF(MX.EQ.3)GO TO 2612
      PP1=PP1-OP1     
	IF(MZ.NE.-1)GO TO 5170
	IF(SPACE.GE.PP1)GO TO 5170
C   PUTS SPACES BETWEEN NOTES .GT. .05( APART
	IF(INONLY.LT.0)WRITE(JOUT,902)
	SPACE=PP1+.05
5170	ML=NPRLN
	IF(NPA.LT.NPRLN)ML=NPA
	MLX=3
	NL=2
	IEND=0
	K=INVIS(J)
	IF(K.EQ.0)GO TO 3170
	IF(K.EQ.-1)GO TO 9170
	IEND=-1
C THIS DELETES END PRINTOUT ( ;PRINT P1  ETC.)
	IF(K.EQ.-2)GO TO 3170
C -1=INVIS FRONT, -2=INVIS END  -3=BOTH
9170	RIN=0
C  NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C  NEXT CREATES FORMAT DATA IN IFM ARRAY.
3029 	KL=3
	GO TO 4170
3170	IF(J.EQ.INONLY)GO TO 775
	IF(INONLY.GE.0)GO TO 2612
775	VX1=PP1
 	IF(IPT(J,NUMPY).EQ.0)GO TO 1303
C NUMPY=NUMP+2
     	DF=ALL(JPT,IPT(J,NUMPY))
C FOR 'DF'=DUTY FACTOR.  A SINGLE NUM. OR READ A PARAM. (NO TEMPO AFFECT.)
1303	IF(DF.GT.0)GO TO 6170
	VX2=PP2+DF
	IF(VX2.LE.0)VX2=PP2/2
C NO NEG. TIME VALUES ALLOWED.
C NEG. DF= FIXED REST AREA BEFORE NEXT ATTACK.
	GO TO 7170
6170	IF(DF.LT.100)GO TO 8170
C DF+100=FIXED NOTE DUR. NOT.GT.PP2   7/74 COLGATE  -AND BELOW
C DF+1000=FIXED TIME OF OVERLAP  3/77  (CHNG THIS TO 300 SOMEDAY!)
	IF(DF.GT.1000)GO TO 8171
	VX2=DF-100.
	IF(VX2.GT.PP2)VX2=PP2
C DF+200= FIXED DURATION WITHOUT REGARD TO OVERLAPS
	IF(DF.GT.200)VX2=DF-200.
	GO TO 7170
C*** NEXT FOR DF>1000 ****!!!! SWITCH THIS FEATURE WITH ORD. DF SOMEDAY!!!!
8171	VX2=PP2+DF-1000.
	GO TO 7170
8170	VX2=PP2*DF
7170	FRM3=B2A
	FRM4=B2B
	KL=5
	IF(NPA.LT.3)GO TO 2121

4170	NL=2
	DO 1121 K=MLX,ML
	X=P(K)
	L=PL(K)
	IF(L-2)321,521,621
C  L=1 NUMBS,  =2 NOTES,FUNCS,  =3 LITS.
321	IF(X.GE.0)GO TO 4211
	FRM(KL)=COMMA
	NL=NL+1
	KL=KL+1
4211	FRM(KL)=B8
	IF(ABS(X).GE.1000.0)FRM(KL)=B9
	FRM(KL+1)=BCOM
	KL=KL+1
	NL=NL+1
421	VX(KL-NL)=X
	GO TO 1121
521	LN=X
	KPAC1=IBLA
	KPAC4=IBLA
C MOST ITEMS WILL HAVE LEADING AND TRAILING BLANKS.
	IF(LN.LT.200)GO TO 2621
	LN=LN-200
CC	IF(LN.LT.10)IVX=IF0+LN*2
CC	IF(LN.GE.10)IVX=IF10 + 256*(LN/10) + 2*MOD(LN,10)
C FOR FUNC NUMS. CAN NOW BE F0→F99.  (RVX AND RVX ARE EQUIV.)
	KPAC2=IFF
	IF(LN.LT.10)GO TO 5521
	KPAC3=N0+536870912*(LN/10)
C11	KPAC3=N0+LN/10
C GETS RIGHT HAND DIGIT
	KPAC4=N0+536870912*MOD(LN,10)
C11	KPAC4=N0+MOD(LN,10)
	GO TO 4521
C11 5521	KPAC3=N0+LN
 5521	KPAC3=N0+LN*536870912
	KPAC4=IBLA
 4521	CALL PACKX(RVX,KPAC)
	VX(KL-NL)=RVX
	GO TO 42
2621	KA=LN-1
	IOCT=KA/12
	LN=MOD(KA,12)+1
	KA=LN
	IF(KA.LT.6)KA=KA-1
	KPAC2=ISC(KA/2+1)
C NOW WE HAVE THE LETTER NAME OF THE NOTE. (NO ACCID.)
	IF(LN.NE.2.AND.LN.NE.4.AND.LN.NE.7.AND.LN.NE.9.AND.
	1 LN.NE.11)GO TO 2521
C CHECK FOR CS, DS, FS, GS, AS
1521	KPAC1=KPAC2
	KPAC2=ISS
2521	IF(IOCT-4)6521,8521,3521
C NEXT FOR CENTRAL OCTAVE
8521	KPAC3=IBLA
	GO TO 4521
3521	KPAC3=ISTAR
7521	KPAC4=MULT(IOCT)
C GETS OCTAVE FACTOR (/8, /4, /2, 0, *2, *4, *8)
	GO TO 4521
6521	KPAC3=KSLA
	GO TO 7521
621	IF(L.GT.3)GO TO 721
	VX(KL-NL)=X
C ABOVE LETS A4 WD BE USED IN SUBR BY SETTING IPL(N)=3.
42	FRM(KL)=BA4
	KL=KL+1
	NL=NL+1
	FRM(KL)=BCOM
C   CREATES '1XA4,'
	GO TO 1121
721	LN=X
	FRM(KL)=B1X
	NL=NL+1
	DO 821 M=1,LN-L+1
C FOR 'LIT' STRINGS
	KL=KL+1
	VX(KL-NL)=V(L-1+M)
821	FRM(KL)=BA1
1121	KL=KL+1

C  NO MORE THAN 80 ITEMS IN FORMAT.
2121	IF(KL.LE.80)GO TO 21211
21212	FORMAT(' ERROR! TOO MANY LIT. ITEMS')
	WRITE(JTYPE,21212)
21211	DO 921 M=KL+1,80
921 	FRM(M)=BLA
	FRM(KL)=BPRN

1921	L=KL-NL-1
	IF(MX.LT.0)WRITE(ID20,FRM)RIN,(VX(K),K=1,L)
	IF(MZ.GE.0)GO TO 3023 
	IF(ML.GE.NPA)FRM(KL)=BDOL
	WRITE(JOUT,FRM),RIN,(VX(K),K=1,L)
3023 	IF(ML.GE.NPA)GO TO 3021
	MLX=ML+1
	ML=ML+NPRLN
	IF(ML.GT.NPA)ML=NPA
	RIN=BLA
  	GO TO 3029 
3021	IF(IEND.LT.0)GO TO 3011
C IEND=-1 FOR INVIS. ENDING.  (ALLOWS EXTENTION OF P LIST.)
	IF(MX.LT.0)WRITE(ID20,3616)RINST(J),ICT
3011	IF(MZ.LT.0)WRITE(JOUT,8902),J,RINST(J),ICT,BT
2612      PP1=ZPAR     
         GO TO 21 
902	FORMAT(1XA4/)
8902	FORMAT('+;<'I2,1XA4,I4,' >',F7.2)
3616	FORMAT(';  < ',A4,I4)
CC3616	FORMAT(';PRINT P1;< ',A4,I4)
C   PRINTS RESTS  
2022	PP2=ABS(PP2)
C   IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2. 
C   FOR RESTS IN SEQS. TYPE -DUR.   
C   WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C    RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
	RNP(J)=0
	P1(J)=PP1+PP2
C   STORES NEXT P1 TIME FOR THIS INST.
	IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21   
      X=PP1-OP1  
	IF(A.GE.X)GO TO 121
	WRITE(JOUT,902)
	A=X+.05
C  NEXT PRINTS A REST INDICATION
121	IF(INONLY.LT.0.OR.J.EQ.INONLY)WRITE(JOUT,1110),RINST(J),X
	1 ,PP2,J,RINST(J),ICT,BT
21	IF(CCHD.EQ.0)GO TO 122
C NEXT FOR CHORDS
	P3=CCHD
	L=LCHD
	NL=-1000
	CCHD=-CCHD
	IJ=JCHD
	GO TO 68
4174	KNT(J)=KNT(J)-1
C TO GET PROPER NOTE COUNT AFTER 'FINE' WAS FOUND.
	GO TO 5174
122	PR=ABS(PR)
	BG(J)=BT+PR 
	IF(ICT.EQ.DUR(J)-10000.)GO TO 5174 
	IF(BG(J).LT.DUR(J))GO TO 500  
5174	BG(J)=19999. 
	DO 3174 K=1,NINS  
C   INSERTS CAN'T FOLLOW LAST REGULAR NOTE.
C   (ADD REST IF INSERT AT END IS NEEDED.)    
3174	IF(BG(K).LT.19999.)GO TO 500     
	GO TO 175   
C   CHOOSES INST WITH NEXT BEGIN TIME.    
500	J=1   
	BW=BT
	NL=NINS
	DO 22 K=2,NL
22      IF(BG(J).GT.BG(K))J=K 
	IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
	J=1
	DO 5022 K=2,NINS
	X=P1(J)
	Y=P1(K)+.0001
C  LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
	IF(BG(J).EQ.19999.)X=19999.
	IF(BG(K).EQ.19999.)Y=19999.
5022	IF(X.GT.Y)J=K
C   ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022      BT=BG(J)    
      IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
	IF(KNT(J).GT.0)GO TO 1022
      IF(KNT(J).EQ.0)P1(J)=0  
      IF(KNT(J).EQ.-1)KNT(J)=0
C   N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0   
1022      IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108    
      T4=T2 
      T5=0  
      T6=10000.   
      GO TO 1108    
1175	FORMAT('+',A4,'=',F7.2,'"',I4,' NTS.',4X,$)
C*1175	FORMAT('+',A5,'=',F7.2,3X,$)
1109	FORMAT(' FINISH; < ',A4,'.DAT'/)
1110	FORMAT(' <',A4,2F8.2,2X,'******* REST <'I2,1XA4,I4,F11.2)
1603  FORMAT(' AMPL. FACTOR=',F5.2,',  P4 MAX.AMP.=',F9.2,',  AT TIME='
	1,F8.3)
175	IF(MZ.LT.0)WRITE(JOUT,1109),FNAME
	IF(MX.GE.0)GO TO 4175
	WRITE(ID20,1109),FNAME
	WRITE(JTYPE,604) 
604  	FORMAT(/' ***** DATA HAS BEEN WRITTEN ON DISK *****'/)
603	FORMAT(' TOTAL DURS:  ',$)
4175	WRITE(JOUT,1603),AMPFAC,RAMP,AMPTIM
	WRITE(JOUT,603)

5175	IJ=0
	Y=0
	DO 2175 K=1,NINS
	X=P1(K)-OP1
	IF(X.GT.Y)Y=X
	J=KNT(K)
	IJ=IJ+J
6175	WRITE(JOUT,1175),RINST(K),X,J
2175	CONTINUE
	IF(NINS.GT.1)WRITE(JOUT,8175)IJ,Y

8175	FORMAT(/' TOTAL NOTES =',I5,F8.2,'"')
1023	FORMAT(/'  < ',A4,'.DAT  --  RANDOM NUMBER=',I6/1X2A4)

3175	WRITE(JTYPE,1023)FNAME,IXIN
	CALL EXIT
	END